program beasylogtest;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  sysutils, Classes, BEasyLog
  { you can add units after this };

Function GetCallStack: String;
var
  i : Longint;
  aPrev, aFrame, aAddr, aPointer: Pointer;
  aBuffer: String;
  aStringList: TStringList;
  aStream: TMemoryStream;
begin
  //routine adapted from fpc source

  //This trick skip SendCallstack item
  //aPointer:=get_frame;
  aPointer := get_caller_frame(get_frame);
  Result := '';
  aStream := TMemoryStream.Create;
  aStringList := TStringList.Create;
  try

    aPrev := aPointer-1;
    i := 0;
    //is_dev:=do_isdevice(textrec(f).Handle);
    While aPointer > aPrev  Do
      Begin
        aAddr := get_caller_addr(aPointer);
        aFrame := get_caller_frame(aPointer);
        If (aAddr = nil) Then
          break;
        //todo: see what is faster concatenate string and use writebuffer or current
        aBuffer := BackTraceStrFunc(aAddr) + LineEnding;
        aStream.WriteBuffer(aBuffer[1],Length(aBuffer));
        Inc(i);
        If Not(i < 50) Or (aFrame = nil) Then
          Break;
        aPrev := aPointer;
        aPointer := aFrame;
      End;
  Except
   { prevent endless dump If an exception occured }
  End;
  aStream.Seek(0, soFromBeginning);
  aStringList.LoadFromStream(aStream);
  Result := aStringList.Text;
  aStream.Free;
  aStringList.Free
End;



Procedure ExceptionTest;
Begin
  LogMethodStart('Procedure ExceptionTest');
  Try
    Raise Exception.Create('Exception Message Info');
  Finally
    LogMethodStop('Procedure ExceptionTest');
  End;
End;

Procedure SubTest;
Begin
  LogMethodStart('Procedure SubTest');
  Log('WTF');
  Log('WTF integer', 100);

  LogMethodStop('Procedure SubTest');
End;

Procedure Test;
Begin
  LogMethodStart('Procedure Test');
  Try
    SubTest;
    ExceptionTest
  Except On E: Exception Do
    LogException(E);
  End;
  LogMethodStop('Procedure Test');
End;

Begin
  InitLogging;
  //LogMethodStart('Procedure WTF');
  //LogMethodStop('Procedure WTF');
  //LogMethodStop('Procedure WTF2');
  Test;

End.

